home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / VISUAL_B / H441.ZIP / VXBTEST.ZIP / VXBMOD.BAS < prev    next >
BASIC Source File  |  1993-05-10  |  15KB  |  446 lines
  1.  
  2. Sub AircraftOpen ()
  3. ' open aircraft file
  4. ' ------------------
  5.    AircraftDbf = vxUseDbf("\vb\vxbtest\aircraft.dbf")
  6.    If AircraftDbf = False Then
  7.       MsgBox "Error Opening aircraft.dbf. Aborting."
  8.       End
  9.    End If
  10.    Aircraf1Ntx = vxUseNtx("\vb\vxbtest\aircraf1.ntx")
  11.    Aircraf2Ntx = vxUseNtx("\vb\vxbtest\aircraf2.ntx")
  12.  
  13. ' Declare Aircraft Table
  14. ' ----------------------
  15.    j% = vxSelectDbf(AircraftDbf)
  16.    Call vxTableDeclare(VX_RED, ByVal 0&, ByVal 0&, 0, 1, 6)
  17.    Call vxTableField(1, "Type", "c_cat", VX_FIELD)
  18.    Call vxTableField(2, "Description", "left(c_desc,20)", VX_EXPR)
  19.    Call vxTableField(3, "Code", "c_code", VX_FIELD)
  20.    Call vxTableField(4, "Price", "c_price", VX_FIELD)
  21.    Call vxTableField(5, "Year", "c_year", VX_FIELD)
  22.    Call vxTableField(6, "TTSN", "c_ttsn", VX_FIELD)
  23.  
  24. End Sub
  25.  
  26. Sub BrowseAir ()
  27.    ' Browse Aircraft File
  28.    ' Called from VXFORM1 OpenAircraft_click and VXFORM6.AirBrowse
  29.    ' ------------------------------------------------------------
  30.  
  31.    ' Select Aircraft File
  32.    ' --------------------
  33.    j% = vxSelectDbf(AircraftDbf)
  34.    j% = vxSelectNtx(Aircraf2Ntx)
  35.  
  36.    ' Open a browse table no editing capabilities
  37.    ' -------------------------------------------
  38.    AircraftReturn = 0  ' declared as GLOBAL so VXFORM6 can interrogate
  39.  
  40.    ' Disable menu items
  41.    ' ------------------
  42.    VXFORM1.OpenCust.Enabled = False
  43.    VXFORM1.OpenAircraft.Enabled = False
  44.    VXFORM1.LinkBuyToSell.Enabled = False
  45.    VXFORM1.LinkSellToBuy.Enabled = False
  46.    VXFORM1.PackFiles.Enabled = False
  47.    
  48.    Form6Active = True  ' true so will be true when browse up
  49.  
  50. ' Execute the browse routine (will use table declared in VXFORM0)
  51. ' ---------------------------------------------------------------
  52.    Call vxBrowse(VXFORM1.hWnd, AircraftDbf, Aircraf2Ntx, False, True, False, 0, "Aircraft On File", AircraftReturn)
  53.  
  54.    Select Case AircraftReturn
  55.  
  56.       Case BROWSE_ERROR
  57.          MsgBox "Error in AirCraft Browse!"
  58.          VXFORM1.OpenCust.Enabled = True
  59.          VXFORM1.OpenAircraft.Enabled = True
  60.          VXFORM1.LinkBuyToSell.Enabled = True
  61.          VXFORM1.LinkSellToBuy.Enabled = True
  62.          VXFORM1.PackFiles.Enabled = True
  63.          Form6Active = False
  64.          Exit Sub
  65.       
  66.       ' user closed browse with sys menu
  67.       ' --------------------------------
  68.       Case BROWSE_CLOSED
  69.          j% = vxSelectDbf(AircraftDbf)
  70.          j% = vxClose()
  71.          VXFORM1.OpenCust.Enabled = True
  72.          VXFORM1.OpenAircraft.Enabled = True
  73.          VXFORM1.LinkBuyToSell.Enabled = True
  74.          VXFORM1.LinkSellToBuy.Enabled = True
  75.          VXFORM1.PackFiles.Enabled = True
  76.          Form6Active = False
  77.          Exit Sub
  78.  
  79.       ' the only other choice is the user double-clicked
  80.       ' a record or pressed the enter key, thereby requesting
  81.       ' a full display on VXFORM6
  82.       ' ------------------------------------------------------
  83.       Case Else
  84.          VXFORM6.Show
  85.   
  86.    End Select
  87.  
  88. End Sub
  89.  
  90. Sub BrowseBuyers ()
  91. ' Select Airbuyer File
  92. ' --------------------
  93.    j% = vxSelectDbf(AirbuyerDbf)
  94.    j% = vxSelectNtx(Airbuy1Ntx)  ' index on customer code
  95.  
  96. ' Open a browse table with no onscreen full editing capabilities
  97. ' --------------------------------------------------------------
  98.    BuyerReturn = 0  ' declared as GLOBAL so VXFORM4 can interrogate
  99.  
  100. ' Execute the browse routine (will use table declared in VXFORM3)
  101. ' ---------------------------------------------------------------
  102.    Call vxBrowse(VXFORM1.hWnd, AirbuyerDbf, Airbuy1Ntx, False, True, True, BuyerRec, "Buyer Records for " + CustKey, BuyerReturn)
  103.  
  104.    Select Case BuyerReturn
  105.  
  106.       Case BROWSE_ERROR
  107.          MsgBox "Error in AirBuyer Browse!"
  108.          
  109.          ' set up return to customer form
  110.          ' ------------------------------
  111.          j% = vxClose()
  112.          StatesOpen
  113.          j% = vxSelectDbf(AircustDbf)
  114.          VXFORM3.Show
  115.          Exit Sub
  116.  
  117.       Case BROWSE_CLOSED
  118.          j% = vxSelectDbf(AirbuyerDbf)
  119.          Call vxTableReset
  120.          j% = vxClose()
  121.          j% = vxSelectDbf(AirTypesDbf)
  122.          Call vxTableReset
  123.          j% = vxClose()
  124.          StatesOpen
  125.          j% = vxSelectDbf(AircustDbf)
  126.          j% = vxSelectNtx(Aircust1Ntx)
  127.          j% = vxSeek(CustKey)
  128.          CustReturn = BROWSE_EDIT
  129.          VXFORM3.Show
  130.  
  131.       ' other choices are processed by VXFORM4
  132.       ' ------------------------------------------
  133.       Case Else
  134.          VXFORM4.Show
  135.    End Select
  136. End Sub
  137.  
  138. ' Browse customer file
  139. ' called from VXFORM1 OpenCust_Click and VXFORM3.CustBrowse
  140. ' ---------------------------------------------------------
  141. Sub BrowseCust ()
  142.  
  143.    ' Select Aircust File
  144.    ' --------------------
  145.    j% = vxSelectDbf(AircustDbf)
  146.    j% = vxSelectNtx(Aircust1Ntx)  ' index on customer code
  147.  
  148.    ' Open a browse table with no onscreen full editing capabilities
  149.    ' --------------------------------------------------------------
  150.    CustReturn = 0  ' declared as GLOBAL so VXFORM3 can interrogate
  151.  
  152.    ' Disable all menu items because this
  153.    ' module uses all other files and we don't want to
  154.    ' interfere with its operation
  155.    ' ------------------------------------------------
  156.    VXFORM1.OpenTypes.Enabled = False
  157.    VXFORM1.OpenCust.Enabled = False
  158.    VXFORM1.OpenAircraft.Enabled = False
  159.    VXFORM1.LinkBuyToSell.Enabled = False
  160.    VXFORM1.LinkSellToBuy.Enabled = False
  161.    VXFORM1.PackFiles.Enabled = False
  162.    VXFORM1.TestCreate.Enabled = False
  163.    VXFORM1.TestCopy.Enabled = False
  164.    VXFORM1.TestDataCopy.Enabled = False
  165.    VXFORM1.FileStruc.Enabled = False
  166.  
  167.    Form3Active = True  ' true so will be true when browse up
  168.  
  169.    ' Execute the browse routine (will use table declared in VXFORM0)
  170.    ' ---------------------------------------------------------------
  171.    TStartRec& = 0
  172.    Call vxBrowse(VXFORM1.hWnd, AircustDbf, Aircust1Ntx, False, True, True, TStartRec&, "Customers", CustReturn)
  173.  
  174.    ' Browse returns a code or record number in CustReturn var.
  175.    ' If an edit menu item is selected, a code is returned.
  176.    ' If the enter key is pressed, the record number is returned.
  177.    ' Double clicks when EditMode is true allow user to edit onscreen.
  178.    ' (return codes defined in global vxbase.txt). In this case,
  179.    ' the EditMode% param is set to FALSE because we have data in
  180.    ' the record that must be properly verified. The onscreen edit
  181.    ' simply blasts the new data into the field and only checks it
  182.    ' for type (Numeric fields must have numbers, etc.).
  183.    ' ----------------------------------------------------------------
  184.   Select Case CustReturn
  185.       Case BROWSE_ERROR
  186.          MsgBox "Error in AirCust Browse!"
  187.          VXFORM1.OpenTypes.Enabled = True
  188.          VXFORM1.OpenCust.Enabled = True
  189.          VXFORM1.OpenAircraft.Enabled = True
  190.          VXFORM1.LinkBuyToSell.Enabled = True
  191.          VXFORM1.LinkSellToBuy.Enabled = True
  192.          VXFORM1.PackFiles.Enabled = True
  193.          VXFORM1.TestCreate.Enabled = True
  194.          VXFORM1.TestCopy.Enabled = True
  195.          VXFORM1.TestDataCopy.Enabled = True
  196.          VXFORM1.FileStruc.Enabled = True
  197.          Form3Active = False
  198.          Exit Sub
  199.       
  200.       ' user closed browse with sys menu
  201.       ' --------------------------------
  202.       Case BROWSE_CLOSED
  203.          j% = vxSelectDbf(AircustDbf)
  204.          j% = vxClose()
  205.          j% = vxSelectDbf(AirstateDbf)
  206.          j% = vxClose()
  207.          VXFORM1.OpenTypes.Enabled = True
  208.          VXFORM1.OpenCust.Enabled = True
  209.          VXFORM1.OpenAircraft.Enabled = True
  210.          VXFORM1.LinkBuyToSell.Enabled = True
  211.          VXFORM1.LinkSellToBuy.Enabled = True
  212.          VXFORM1.PackFiles.Enabled = True
  213.          VXFORM1.TestCreate.Enabled = True
  214.          VXFORM1.TestCopy.Enabled = True
  215.          VXFORM1.TestDataCopy.Enabled = True
  216.          VXFORM1.FileStruc.Enabled = True
  217.          Form3Active = False
  218.          Exit Sub
  219.  
  220.       ' all other choices are processed by VXFORM3
  221.       ' ------------------------------------------
  222.       Case Else
  223.          VXFORM3.Show
  224.   
  225.    End Select
  226. End Sub
  227.  
  228. Sub BrowseTypes ()
  229.    ' Browse Aircraft Types File
  230.    ' Called from VXFORM1 OpenTypes_click and VXFORM2.TypeBrowse
  231.    ' ----------------------------------------------------------
  232.  
  233.    ' Select Airtypes File
  234.    ' --------------------
  235.    j% = vxSelectDbf(AirTypesDbf)
  236.    j% = vxSelectNtx(AirtypesNtx)
  237.  
  238.    ' Open a browse table with full editing capabilities
  239.    ' --------------------------------------------------
  240.    TypeReturn = 0  ' declared as GLOBAL so VXFORM2 can interrogate
  241.  
  242.    ' disable menu items
  243.    ' ------------------
  244.    VXFORM1.OpenTypes.Enabled = False
  245.    VXFORM1.OpenCust.Enabled = False
  246.    VXFORM1.PackFiles.Enabled = False
  247.    VXFORM1.TestCreate.Enabled = False
  248.    VXFORM1.TestCopy.Enabled = False
  249.    VXFORM1.TestDataCopy.Enabled = False
  250.  
  251.    Form2Active = True  ' true so will be true when browse up
  252.  
  253.    ' Execute the browse routine (will use table declared in TypesOpen)
  254.    ' -----------------------------------------------------------------
  255.    TStartRec& = 0
  256.    Call vxBrowse(VXFORM1.hWnd, AirTypesDbf, AirtypesNtx, True, True, True, TStartRec&, "Aircraft Types", TypeReturn)
  257.    
  258.    ' Browse returns a code or record number in TypeReturn var.
  259.    ' If an edit menu item is selected, a code is returned.
  260.    ' If the enter key is pressed, the record number is returned.
  261.    ' Double clicks when EditMode is true allow user to edit onscreen.
  262.    ' (return codes defined in global vxbase.txt)
  263.    ' ----------------------------------------------------------------
  264.    Select Case TypeReturn
  265.  
  266.       Case BROWSE_ERROR
  267.          MsgBox "Error in AirTypes Browse!"
  268.          VXFORM1.OpenTypes.Enabled = True
  269.          VXFORM1.OpenCust.Enabled = True
  270.          VXFORM1.PackFiles.Enabled = True
  271.          VXFORM1.TestCreate.Enabled = True
  272.          VXFORM1.TestCopy.Enabled = True
  273.          VXFORM1.TestDataCopy.Enabled = True
  274.          Form2Active = False
  275.          Exit Sub
  276.       
  277.       ' user closed browse with sys menu
  278.       ' --------------------------------
  279.       Case BROWSE_CLOSED
  280.          j% = vxSelectDbf(AirTypesDbf)
  281.          j% = vxClose()
  282.          VXFORM1.OpenTypes.Enabled = True
  283.          VXFORM1.OpenCust.Enabled = True
  284.          VXFORM1.PackFiles.Enabled = True
  285.          VXFORM1.TestCreate.Enabled = True
  286.          VXFORM1.TestCopy.Enabled = True
  287.          VXFORM1.TestDataCopy.Enabled = True
  288.          Form2Active = False
  289.          Exit Sub
  290.  
  291.       ' all other choices are processed by VXFORM2
  292.       ' ------------------------------------------
  293.       Case Else
  294.          VXFORM2.Show
  295.   
  296.    End Select
  297. End Sub
  298.  
  299. Sub BuyerOpen ()
  300.    AirbuyerDbf = vxUseDbf("\vb\vxbtest\airbuyer.dbf")
  301.    Airbuy1Ntx = vxUseNtx("\vb\vxbtest\airbuy1.ntx")
  302.    Airbuy2Ntx = vxUseNtx("\vb\vxbtest\airbuy2.ntx")
  303. End Sub
  304.  
  305. Sub CursorArrow ()
  306.    hinst% = 0
  307.    ctype& = IDC_ARROW
  308.    hcr% = LoadCursor(hinst%, ctype&)
  309.    j% = SetCursor(hcr%)
  310. End Sub
  311.  
  312. Sub CursorWait ()
  313.    hinst% = 0
  314.    ctype& = IDC_WAIT
  315.    hcr% = LoadCursor(hinst%, ctype&)
  316.    j% = SetCursor(hcr%)
  317. End Sub
  318.  
  319. Function EmptyString (TestString As String) As Integer
  320.    EmptyString = True
  321.    If Len(TestString) = 0 Then Exit Function
  322.    
  323.    For i% = 1 To Len(TestString)
  324.       If Mid$(TestString, i%, 1) <> Chr$(32) Then
  325.          EmptyString = False
  326.          Exit For
  327.       End If
  328.    Next
  329.  
  330. End Function
  331.  
  332. Sub ProcessError ()
  333.    ' The vxBase error structure is defined
  334.    ' in the Global module. A Global type
  335.    ' vxError is also defined that is filled
  336.    ' by the vxErrorTest function.
  337.  
  338.    ' This procedure is called from the TypesOpen
  339.    ' Sub in this module. There is an intentional
  340.    ' file open error created in TypesOpen to
  341.    ' illustrate the vxBase alternate error method.
  342.    
  343.    ' processes vxBase alternate error messages
  344.    ' -----------------------------------------
  345.    Select Case vxError.ErrorNum
  346.       ' 620 File Open
  347.       Case 620
  348.          MsgBox "vxBase INTENTIONAL error" + Chr$(13) + Chr$(10) + "Opening File " + RTrim$(vxError.BadParm)
  349.       Case Else
  350.          MsgBox vxError.ErrorMsg
  351.    End Select
  352.  
  353.    ' see Appendix A in the vxBase manual
  354.    ' for a description of all errors
  355.  
  356.    ' identify what you feel are catastrophic
  357.    ' errors (like a 620 error) and abort
  358.    ' the program run entirely with an END
  359.    ' statement
  360.    
  361. End Sub
  362.  
  363. Sub StatesOpen ()
  364.  
  365. ' open state abbreviations file
  366. ' -----------------------------
  367.    AirstateDbf = vxUseDbf("\vb\vxbtest\airstate.dbf")
  368.    If AirstateDbf = False Then
  369.       MsgBox "Error Opening airstate.dbf. Aborting."
  370.       End
  371.    End If
  372.    Airstat1Ntx = vxUseNtx("\vb\vxbtest\airstat1.ntx")
  373.    Airstat2Ntx = vxUseNtx("\vb\vxbtest\airstat2.ntx")
  374.  
  375. ' Declare table used in help function
  376. ' -----------------------------------
  377.    Call vxTableDeclare(VX_BLUE, ByVal 0&, ByVal 0&, 0, 1, 2)
  378.    Call vxTableField(1, "Code", "statecode", VX_FIELD)
  379.    Call vxTableField(2, "Name", "statename", VX_FIELD)
  380.  
  381. End Sub
  382.  
  383. Sub TypesOpen ()
  384. ' Open aircraft types file
  385. ' ------------------------
  386.    AirTypesDbf% = vxUseDbf("\vb\vxbtest\airtypes.dbf")
  387.    
  388.    If AirTypesDbf% = False Then
  389.       MsgBox "Error opening airtypes.dbf. Aborting."
  390.       Exit Sub
  391.    End If
  392.    
  393.    AirtypesNtx = vxUseNtx("\vb\vxbtest\airtypes.ntx")
  394.    If AirtypesNtx = False Then
  395.       MsgBox "Error Opening airtypes.ntx. Aborting."
  396.       j% = vxClose()
  397.       Exit Sub
  398.    End If
  399.  
  400.    ' test alternate error method
  401.    ' ---------------------------
  402.    ' the error generated beolow is an intentional
  403.    ' error to illustrate how the alternate
  404.    ' error method works.
  405.  
  406.    ' VB 2.0 uses the standard VB On Error method
  407.    ' -------------------------------------------
  408.    On Error GoTo VBErrorRtn
  409.    Call vxSetErrorMethod(True)
  410.    jj% = vxUseNtx("\vb\vxbtest\testerr.ntx")
  411.  
  412.    ' VB 1.0 would not set On Error. Instead,
  413.    ' the following code would follow the vxBase
  414.    ' call that might result in an error
  415.    ' ------------------------------------------
  416.    'If vxErrorTest(vxError) Then
  417.    '   ProcessError
  418.    'End If
  419.    ' ------------------------------------------
  420.  
  421.    Call vxSetErrorMethod(False)
  422.  
  423.    j% = vxSelectNtx(AirtypesNtx)
  424.  
  425. ' Declare types table to get nice headings
  426. ' (TableDeclare works on currently selected DBF)
  427. ' ----------------------------------------------
  428.    Call vxTableDeclare(VX_RED, ByVal 0&, ByVal 0&, 0, 1, 2)
  429.    Call vxTableField(1, "Type", "category", VX_FIELD)
  430.    Call vxTableField(2, "Description", "catname", VX_FIELD)
  431.  
  432.    Call vxFilter(".NOT. deleted()")
  433.    Exit Sub
  434.  
  435. VBErrorRtn:
  436.    Debug.Print Err
  437.    MsgBox "vxBase error encountered"
  438.    If vxErrorTest(vxError) Then
  439.       ProcessError
  440.    End If
  441.  
  442.    Resume Next
  443.  
  444. End Sub
  445.  
  446.